home *** CD-ROM | disk | FTP | other *** search
/ Shareware Super Platinum 8 / Shareware Super Platinum 8.iso / mac / PROGTOOL / EUPHOR10.ZIP;1 / PLOT3D.EX < prev    next >
Encoding:
Text File  |  1993-06-25  |  5.9 KB  |  255 lines
  1.         --------------------------------
  2.         -- Plotting of 3-D Surfaces:  --
  3.         -- Z as a function of X and Y --
  4.         --------------------------------
  5.  
  6. -- The program does a quick plot of each function to get the scaling right,
  7. -- then replots so the picture will fit neatly on the screen.
  8. -- The 4 x-y quadrants are in different colors.
  9. -- Where z is positive, a brighter shade of color is used.
  10. -- edit the_function() to insert your function
  11. -- set GRAPHICS_MODE = a good mode for your machine
  12. --                (see euphoria\include\graphics.e for a list of modes)
  13. -- Press Enter at any time to skip to the next function.
  14.  
  15. constant GRAPHICS_MODE = 261  -- choose the best mode for your machine
  16.  
  17. without type_check
  18.  
  19. include graphics.e
  20. include select.e
  21.  
  22. constant NFUNCS = 6
  23. constant c = sqrt(2.0) / 2
  24. constant SCREEN = 1
  25.  
  26. atom x_min, x_max, x_inc
  27. atom y_min, y_max, y_inc
  28. atom z_min, z_max
  29. atom xc_min, xc_max, yc_min, yc_max
  30.  
  31. atom origin_x, origin_y
  32. origin_x = 400
  33. origin_y = 150
  34.  
  35. integer func_no
  36. integer grid_width, fine
  37. integer x_res, y_res
  38.  
  39. atom h_magnifier, v_magnifier
  40.  
  41. sequence prev_coord
  42.  
  43. function abs(atom x)
  44.     if x < 0 then
  45.     return -x
  46.     else
  47.     return x
  48.     end if
  49. end function
  50.  
  51. function the_function(atom x, atom y)
  52. -- compute a function z of two variables x and y
  53. -- There are actually several different functions below,
  54. -- selected by the func_no variable
  55.     sequence pq, pr, ps -- points in the plane
  56.     atom dq, dr, ds     -- distance from p
  57.     atom z, w
  58.  
  59.     if func_no = 1 then
  60.     return 100*x*x + 100*y*y - 50
  61.  
  62.     elsif func_no = 2 then
  63.     return 200*x*x*x - 200*y*y*y
  64.  
  65.     elsif func_no = 3 then
  66.     return 50 * cos(8*x*y)
  67.  
  68.     elsif func_no = 4 then
  69.     return 50 * cos(8*(x+y))
  70.  
  71.     elsif func_no = 5 then
  72.     z = 50 * cos(50 * sqrt(x*x+y*y))
  73.     if z >= -0.01 then
  74.         if (x < 0 and y < 0) or (x > 0 and y > 0) then
  75.         return z / 10
  76.         else
  77.         return z
  78.         end if
  79.     else
  80.         return -0.01
  81.     end if
  82.     elsif func_no = 6 then
  83.     pq = {.6, -.4}
  84.     pr = {-.6, 0}
  85.     ps = {.5, +.5}
  86.     dq = sqrt((x-pq[1]) * (x-pq[1]) + (y-pq[2]) * (y-pq[2]))
  87.     dr = sqrt((x-pr[1]) * (x-pr[1]) + (y-pr[2]) * (y-pr[2]))
  88.     ds = sqrt((x-ps[1]) * (x-ps[1]) + (y-ps[2]) * (y-ps[2]))
  89.     z = -25 * cos(ds*15)/(0.1 + ds*sqrt(ds)) +
  90.          75 * cos(dq*3) /(0.1 + dq*sqrt(dq))
  91.     if x < 0 then
  92.         w = 60 * cos(9 * dr)
  93.         if w < 0 then
  94.         w = 0
  95.         else
  96.         w = w * 2 * sqrt(-x)
  97.         end if
  98.         z = z + w
  99.     end if
  100.     return z
  101.     end if
  102. end function
  103.  
  104. procedure set_range()
  105.     -- magnification factors
  106.     h_magnifier = 1.0
  107.     v_magnifier = 1.0
  108.  
  109.     -- extreme values
  110.     xc_min = 1e307
  111.     xc_max = -1e307
  112.     yc_min = xc_min
  113.     yc_max = xc_max
  114.     z_min = xc_min
  115.     z_max = xc_max
  116.  
  117.     -- range of values to plot
  118.     x_min = -1
  119.     x_max = +1
  120.     y_min = -1
  121.     y_max = +1
  122.  
  123.    -- calculate some derived values:
  124.     x_inc = (x_max - x_min) / x_res
  125.     y_inc = (y_max - y_min) / y_res
  126. end procedure
  127.  
  128. procedure note_extreme(sequence coord, atom z)
  129. -- record the extreme values
  130.     if coord[1] < xc_min then
  131.     xc_min = coord[1]
  132.     elsif coord[1] > xc_max then
  133.     xc_max = coord[1]
  134.     end if
  135.     if coord[2] < yc_min then
  136.     yc_min = coord[2]
  137.     elsif coord[2] > yc_max then
  138.     yc_max = coord[2]
  139.     end if
  140.     if z > z_max then
  141.     z_max = z
  142.     elsif z < z_min then
  143.     z_min = z
  144.     end if
  145. end procedure
  146.  
  147. function set_coord(atom x, atom y, atom z)
  148. -- return the coordinates to plot, given the x, y and z values
  149.     atom k
  150.  
  151.     k = (x - x_min)/x_inc * c
  152.     return {h_magnifier * (origin_x + (y - y_min)/y_inc - k),
  153.         v_magnifier * (origin_y - z + k)}
  154. end function
  155.  
  156. procedure plot(atom x, atom y)
  157. -- plot the point according to 3-D perspective
  158.     atom z, col
  159.     sequence coord
  160.  
  161.     z = the_function(x, y)
  162.     coord = set_coord(x, y, z)
  163.     note_extreme(coord, z)
  164.     -- select color by quadrant
  165.     col = (z >= 0) * 8 + (x >= 0) * 2 + (y >= 0) + 1
  166.     if length(prev_coord) = 0 then
  167.     pixel(col, coord)
  168.     else
  169.     draw_line(col, 1, {prev_coord, coord})
  170.     end if
  171.     prev_coord = coord
  172. end procedure
  173.  
  174. function plot_a_function()
  175. -- generate 3d plotted graph for a user inputs
  176.  
  177.     for x = x_min to x_max by grid_width * x_inc do
  178.     if get_key() != -1 then
  179.         return 0
  180.     end if
  181.     prev_coord = {}
  182.     for y = y_min to y_max by fine * y_inc do
  183.         plot(x, y)
  184.     end for
  185.     end for
  186.  
  187.     for y = y_min to y_max by grid_width * y_inc do
  188.     if get_key() != -1 then
  189.         return 0
  190.     end if
  191.     prev_coord = {}
  192.     for x = x_min to x_max by fine * x_inc do
  193.         plot(x, y)
  194.     end for
  195.     end for
  196.     return 1
  197. end function
  198.  
  199. procedure box()
  200. -- draw a box around the outside of edge of the screen
  201.     polygon(5, 1, 0, {{0, 0}, {0, y_res-1}, {x_res-1, y_res-1}, {x_res-1, 0}})
  202. end procedure
  203.  
  204. procedure plot3d()
  205. -- main program
  206.     func_no = 1
  207.     while func_no <= NFUNCS do
  208.     set_range()
  209.     -- do a quick trial run to establish range of values
  210.     grid_width = 20
  211.     fine = 4
  212.     if plot_a_function() then
  213.         clear_screen()
  214.         box()
  215.         -- make next one fit screen better
  216.         v_magnifier = (y_res - 1) / (yc_max - yc_min)
  217.         h_magnifier = (x_res - 1) / (xc_max - xc_min)
  218.         origin_x = origin_x - xc_min
  219.         origin_y = origin_y - yc_min
  220.         grid_width = 20
  221.         fine = 1
  222.         if plot_a_function() then
  223.         position(2, 2)
  224.         printf(SCREEN, "x: %5.1f to %4.1f", {x_min, x_max})
  225.         position(3, 2)
  226.         printf(SCREEN, "y: %5.1f to %4.1f", {y_min, y_max})
  227.         position(4, 2)
  228.         printf(SCREEN, "z: %5.1f to %4.1f", {z_min, z_max})
  229.         while get_key() = -1 do
  230.         end while
  231.         end if
  232.     end if
  233.     func_no = func_no + 1
  234.     clear_screen()
  235.     end while
  236. end procedure
  237.  
  238. sequence config
  239.  
  240. -- execution starts here:
  241. if select_mode(GRAPHICS_MODE) then
  242.     config = video_config()
  243.     x_res = config[VC_XPIXELS]
  244.     y_res = config[VC_YPIXELS]
  245.     plot3d()
  246.     if config[VC_COLOR] then
  247.         graphics_mode(3)
  248.     else
  249.     graphics_mode(7)
  250.     end if
  251. else
  252.     puts(1, "couldn't find a good graphics mode\n")
  253. end if
  254.  
  255.